Quarterly Collisions in Bloor, University, Danforth, and Yonge

R Code

Libraries

Load libraries, the main ones being used are ggplot2 for plotting, leaflet and tmap for interactive maps, sf for spatial data processing, tidyverse for data processing, and DT for interactive tables.

# Load libraries
library(ggplot2)
library(leaflet)
library(leaflet.extras)
library(lubridate)
library(sf)
library(glue)
library(tidyverse)
library(tmap)
library(DT)

Functions

Create a function to assign default behaviour for our DT datatables.

# Function for default datatable params
datatable <- function(...) {
    
    # Build arg list
    args <- list(...)
    
    # Default custom filename
    filename <- if (!"filename" %in% names(args)) "data" else args$filename
    args[["filename"]] <- NULL
    
    # Add default extensions
    args$extensions <- if (!"extensions" %in% names(args)) "Buttons" else args$extensions
    
    # Add default args
    args$filter <- if (!"filter" %in% names(args)) "top" else args$filter
    args$fillContainer <- if (!"fillContainer" %in% names(args)) T else args$fillContainer
    
    # Add default options
    if (!"options" %in% names(args)) {
        args$options <-  list(
            scrollY = "350px",
            buttons = list(
                list(
                    extend = "csv",
                    filename = filename,
                    exportOptions = list(columns = ":not(.rownames)")
                ),
                list(
                    extend = "excel",
                    filename = filename,
                    exportOptions = list(columns = ":not(.rownames)"),
                    title = ""
                )
            ),
            columnDefs = list(
                list(
                    targets = 0,
                    className = "rownames"
                )
            ),
            dom = "Bfrtip"
        )
    }
    return(do.call(DT::datatable, args))
}

Data

Load the following data for the City of Toronto:

• boundary
• centrelines
• all collisions
• verified bikeways

All collisions data was provided by David McElroy David.McElroy@toronto.ca from the City of Toronto on November 7, 2024.

Verified bikeways data originally from Konrad Samsel konrad.samsel@mail.utoronto.ca and later modified by Richard Wen richard.wen@utoronto.ca on October 27, 2024.

# Load boundaries
bounds_raw <- read_sf("../../data/toronto-boundary-2019-07-23/citygcs_regional_mun_wgs84.shp")

# Load toronto centrelines data
ctl_raw <- read_sf("../../data/toronto-centrelines-2024-12-06.geojson")

# Load toronto bikeways data
bike_raw <- read_sf("../../data/toronto-bikeways-2024-10-27.geojson")

# Load all toronto collisions from 2022 to 2024
colli_raw <- read_sf(
    "../../tmp/i0327_collisionsrep_acc_export.csv",
    options = c(
        "X_POSSIBLE_NAMES=LONGITUDE",
        "Y_POSSIBLE_NAMES=LATITUDE"
    ),
    crs = 4326
)

Cleaning

For the collisions:

1. Crop all collision points to the boundaries of the City of Toronto
2. Convert the accident date ACCDATE to date type
3. Add a column to separate the collisions data for Killed or Seriously Injured (KSI) and non-KSI individuals
4. Add columns to identify drivers (and passengers), pedestrians, cyclists (and cyclist passengers), and other road users

For the verified bikeways:

1. Filter for Bloor Street, University Avenue, and Yonge Street
2. Calculate the final type and year for each verified bikeway, where improvements (when the same type occurs between upgrades) are not considered an upgrade
3. Filter for cycle tracks only based on the final type

For the centrelines, extract target streets Bloor Street, Danforth Street/Avenue, University Avenue, and Yonge Street, and merge all segments for each target street.

# Reproj city bounds to 4326
bounds <- bounds_raw %>% st_transform(4326)

# Crop colli to toronto bounds and convert date type
colli <- colli_raw %>%
    st_intersection(bounds) %>%
    mutate(colli_date = as_date(ACCDATE))

# Add a columns for ksi and road users
ksi_codes <- c("3", "4")
colli <- colli %>%
    mutate(
        ksi = if_else(INJURY %in% ksi_codes, "ksi", "non_ksi"), # ksi col
        user = case_when( # road user col
            INVTYPE %in% c("01", "02") ~ "driver",
            INVTYPE == "03" ~ "pedestrian",
            INVTYPE %in% c("04", "05") ~ "cyclist",
            .default = "other"
        )
    )

# Get cycle tracks only after all upgrades
bike <- bike_raw %>%
    mutate( # create col for target streets
        target_street = case_when(
            str_starts(street, "Bloor") ~
                "Bloor Street",
            str_starts(street, "University") ~
                "University Avenue",
            str_starts(street, "Yonge") ~
                "Yonge Street",
            str_starts(street, "Danforth") ~
                "Danforth Street/Avenue",
            .default = NA
        )
    ) %>%
    filter(!is.na(target_street)) %>%
    mutate(
        final_type = case_when( # col for final type without improvements
            !is.na(verify_upgrade2_year) &
            verify_upgrade2_type != verify_upgrade1_type
                ~ verify_upgrade2_type,
            !is.na(verify_upgrade1_year) &
            verify_upgrade1_type != verify_install_type
                ~ verify_upgrade1_type,
            !is.na(verify_install_year)
                ~ verify_install_type,
            .default = NA
        ),
        final_type = case_when( # remap infra types to actual names
            final_type %in% c("PL", "BUF") ~ "Painted Lane",
            final_type == "PBL" ~ "Cycle Track",
            .default = NA
        )
    ) %>%
    mutate( # col for final year without improvements
        final_year = case_when(
            !is.na(verify_upgrade2_year) &
            verify_upgrade2_type != verify_upgrade1_type
                ~ verify_upgrade2_year,
            !is.na(verify_upgrade1_year) &
            verify_upgrade1_type != verify_install_type
                ~ verify_upgrade1_year,
            !is.na(verify_install_year)
                ~ verify_install_year,
            .default = NA
        ),
        history = glue("
            {verify_install_type},{verify_install_year} -> 
            {verify_upgrade1_type},{verify_upgrade1_year} -> 
            {verify_upgrade2_type},{verify_upgrade2_year}
        ")
    ) %>%
    filter( # filter for cycle tracks only
        final_type == "Cycle Track"
    )

# Remove non pl and ct types
bike <- bike %>%
    mutate(
        verify_install_type = if_else(
            verify_install_type %in% c("PL", "BUF", "PBL"),
            verify_install_type,
            NA
        ),
        verify_upgrade1_type = if_else(
            verify_upgrade1_type %in% c("PL", "BUF", "PBL"),
            verify_upgrade1_type,
            NA
        ),
        verify_upgrade2_type = if_else(
            verify_upgrade2_type %in% c("PL", "BUF", "PBL"),
            verify_upgrade2_type,
            NA
        )
    )

# Add history to bike lanes without improvements
bike <- bike %>%
    mutate( # remove improvements
        verify_upgrade1_year = if_else(
            !is.na(verify_upgrade1_type) &
            !is.na(verify_install_type) &
            verify_install_type == verify_upgrade1_type,
            NA,
            verify_upgrade1_year
        ),
        verify_upgrade1_type = if_else(
            !is.na(verify_upgrade1_type) &
            !is.na(verify_install_type) &
            verify_install_type == verify_upgrade1_type,
            NA,
            verify_upgrade1_type
        ),
        verify_upgrade2_year = if_else(
            !is.na(verify_upgrade2_type) &
            !is.na(verify_upgrade1_type) &
            verify_upgrade2_type == verify_upgrade1_type,
            NA,
            verify_upgrade2_year
        ),
        verify_upgrade2_type = if_else(
            !is.na(verify_upgrade2_type) &
            !is.na(verify_upgrade1_type) &
            verify_upgrade2_type == verify_upgrade1_type,
            NA,
            verify_upgrade2_type
        )
    ) %>%
    mutate(
        history = glue(
            "{verify_install_type},{verify_install_year}",
            " -> {verify_upgrade1_type},{verify_upgrade1_year}",
            " -> {verify_upgrade2_type},{verify_upgrade2_year}",
        ) %>%
            str_remove_all(" -> NA,NA|NA,NA -> |NA,NA")
    )

# Filter centrelines for Bloor, University and Yonge
streets <- ctl_raw %>%
    filter( # filter for streets only
        FEATURE_CODE_DESC %in% c(
            "Major Arterial",
            "Major Arterial Ramp",
            "Minor Arterial",
            "Minor Arterial Ramp",
            "Collector",
            "Access Road",
            "Other",
            "Laneway",
            "Local"
        )
    ) %>%
    mutate( # create col for streets bloor, uni, and yonge
        target_street = case_when(
            str_starts(
                LINEAR_NAME_FULL_LEGAL,
                "Bloor Street"
            ) ~ "Bloor Street",
            str_starts(
                LINEAR_NAME_FULL_LEGAL,
                "University Avenue"
            ) ~ "University Avenue",
            str_starts(
                LINEAR_NAME_FULL_LEGAL,
                "Yonge Street"
            ) ~ "Yonge Street",
            str_starts( # Prince Edward Viaduct
                LINEAR_NAME_FULL_LEGAL,
                "Danforth Avenue|Danforth Street"
            ) ~ "Danforth Street/Avenue",
            .default = NA
        )
    ) %>%
    filter(!is.na(target_street)) %>%
    group_by(target_street) %>% # merge geoms on streets
    summarize(geometry = st_union(geometry))

Processing

Find all collision points within 25 meters of the verified bikeways on Yonge, Bloor and University.

# Get row indices of nearest bikeway to each collision
near_idx <- colli %>% st_nearest_feature(bike)

# Calc distances to nearest bikeway for each collision
colli_bike <- colli %>%
    mutate( # calc dist to nearest bikeway for each ksi
        `near_bike_meters` = st_distance(
            geometry,
            bike[near_idx, ],
            by_element = T
        ) %>% as.numeric
    )

# Get df version of bike and calc lens
bike_df <- bike %>%
    mutate(
        bike_len_km = as.numeric(st_length(geometry)) / 1000
    ) %>%
    as_tibble %>%
    select(-geometry)

# Add bike columns to collisions
colli_bike <- colli_bike %>%
    mutate( # add ids for bike
        bike_id = bike_df[near_idx, ]$id
    ) %>%
    left_join( # add bike cols to colli
        bike_df,
        by = join_by(bike_id == id)
    )

# Filter for collisions within 25 meters of the bikeways
colli_bike <- colli_bike %>%
    filter(near_bike_meters <= 25)

Count the injuries by the collision quarter, KSI/Non-KSI, and road user.

# Expand into bike events
colli_bike_proc <- colli_bike %>%
    pivot_longer(
        c(
            verify_install_type,
            verify_upgrade1_type,
            verify_upgrade2_type
        ),
        names_to = "event",
        values_to = "type"
    ) %>%
    mutate( # add time units
        year = year(colli_date),
        quarter = quarter(colli_date),
    ) %>%
    mutate( # correct years and types
        event_year = case_when(
            str_starts(event, "verify_install_type") ~ verify_install_year,
            str_starts(event, "verify_upgrade1_type") ~ verify_upgrade1_year,
            str_starts(event, "verify_upgrade2_type") ~ verify_upgrade2_year
        ),
        type = if_else(
            is.na(type) & event == "verify_install_type",
            "none",
            type
        ),
        type = case_when(
            type %in% c("PL", "BUF") ~ "painted lane",
            type == "PBL" ~ "cycle track",
            .default = type
        )
    ) %>%
    filter( # remove na types
        !is.na(type) &
        year >= event_year
    )

# Count by quarterly individuals
colli_counts <- colli_bike_proc %>%
    as_tibble %>%
    select(-geometry) %>%
    rename(
        orig_street = street,
        street = target_street
    ) %>%
    group_by(year, quarter, street, type, user, ksi) %>%
    group_map(~ {
        head(.x, 1) %>%
            mutate(
                n = nrow(.x),
                n_segments = length(unique(.x$bike_id)),
                n_len_km = .x %>% # calc lens of unique bikeways
                    distinct(bike_id, .keep_all = T) %>%
                    pull(bike_len_km) %>%
                    sum(na.rm = T)
            ) %>%
            select(colnames(.y), n, n_segments, n_len_km)
    }, .keep = T) %>%
    bind_rows %>%
    arrange(street, year, quarter, type, user, ksi) %>%
    ungroup

# Add counts for Bloor and Danforth together
colli_counts <- colli_counts %>%
    add_row(
        colli_counts %>%
            filter(street %in% c(
                "Bloor Street",
                "Danforth Street/Avenue")
            ) %>%
            mutate(street = "Bloor & Danforth") %>%
            group_by(year, quarter, street, type, user, ksi) %>%
            summarize(
                n = sum(n, na.rm = T),
                n_segments = sum(n_segments, na.rm = T),
                n_len_km = sum(n_len_km, na.rm = T)
            )
    )

# Create all combos of colli
colli_counts <- expand.grid(
    year = min(colli_counts$year):max(colli_counts$year),
    quarter = 1:4,
    street = unique(colli_counts$street),
    type = unique(colli_counts$type),
    user = unique(colli_counts$user),
    ksi = unique(colli_counts$ksi)
) %>%
    left_join(
        colli_counts,
        by = c(
            "year",
            "quarter",
            "street",
            "type",
            "user",
            "ksi"
        )
    ) %>%
    mutate(
        n = replace_na(n, 0),
        n_segments = replace_na(n_segments, 0),
        n_len_km = replace_na(n_len_km, 0)
    ) %>%
    arrange(street, year, quarter, type, user, ksi)

Add installs/upgrades of painted lane and cycle track infrastructure, if they are present in the collision quarter.

# Add bikeways for bloor and danforth together
bike_proc <- bike %>%
    add_row(
        bike %>%
            filter(target_street %in% c(
                "Bloor Street",
                "Danforth Street/Avenue"
            )) %>%
            mutate(target_street = "Bloor & Danforth")
    )

# Calc cycle track events with segment length and counts
bike_events <- data.frame(
    year = c(
        bike_proc$verify_install_year,
        bike_proc$verify_upgrade1_year,
        bike_proc$verify_upgrade2_year
    ),
    add_type = c(
        bike_proc$verify_install_type,
        bike_proc$verify_upgrade1_type,
        bike_proc$verify_upgrade2_type
    ),
    street = rep(bike_proc$target_street, 3),
    geometry = rep(bike_proc$geometry, 3)
) %>%
    mutate(
        add_type = case_when(
            add_type %in% c("PL", "BUF") ~ "painted lane",
            add_type == "PBL" ~ "cycle track",
            .default = add_type
        )
    ) %>%
    filter(!is.na(year) & !is.na(add_type)) %>%
    st_as_sf %>%
    group_by(street, year, add_type) %>%
    summarize(
        add_len_km = as.numeric(sum(st_length(geometry))) / 1000,
        add_segments = n()
    ) %>%
    as_tibble %>%
    select(-geometry) %>%
    mutate(
        add_year = year
    ) %>%
    arrange(street, year) %>%
    group_by(street) %>%
    mutate(
        add_segments = cumsum(add_segments)
    ) %>%
    ungroup

# Fill years in between infra events
bike_events_fill <- bike_events %>%
    group_by(street) %>%
    group_map(~{
        expand.grid(
            year = min(colli_counts$year, na.rm = T):max(colli_counts$year, na.rm = T)
        ) %>%
            left_join(.x, by = "year") %>%
            fill(everything()) %>%
            fill(street, .direction = "up")
    }, .keep = T) %>%
    bind_rows

# Add bike events to the counts
colli_counts <- colli_counts %>%
    left_join(
        bike_events_fill %>%
            select(
                year,
                street,
                add_segments,
                add_type,
                add_year,
                add_len_km
            ),
        by = c("year", "street")
    ) %>%
    arrange(street, year, quarter, add_type, user, ksi)

# Add post col to define if year is post first install of a cycle track
colli_counts <- colli_counts %>%
    group_by(street) %>%
    group_map(~{
        
        # Set out df
        out <- .x
        
        # Calculate first ct and pl if exists
        pl_ymin <- colli_counts %>%
            filter(add_type == "painted lane") %>%
            pull(year)
        ct_ymin <- colli_counts %>%
            filter(add_type == "cycle track") %>%
            pull(year)
        
        # Post pl col
        if (length(pl_ymin) > 0) {
            out <- out %>%
                mutate(
                    post_1st_pl = if_else(
                        .x$add_type == "painted lane" &
                        .x$year >= min(pl_ymin, na.rm = T),
                        T,
                        F
                    )
                )
        }
        
        # Post first ct col
        if (length(ct_ymin) > 0) {
            out <- out %>%
                mutate(
                    post_1st_ct = if_else(
                        .x$add_type == "cycle track" &
                        .x$year >= min(ct_ymin, na.rm = T),
                        T,
                        F
                    )
                )
        }
        
        # Return df with post cols
        return(out)
        
    }, .keep = T) %>%
    bind_rows

Results

The results contain:

1. Data in wide format with collision counts divided by road user and KSI/Non-KSI for each street by year
2. A plot showing when the data in 1. with when the cycle tracks were implemented for each street
3. A map showing the locations of the cycle tracks for each street and a heatmap of the collision density

Data

All

The resulting data consists of the following columns:

• year the year of the collisions
• quarter: the quarter of the collisions
• street: the street, one of Yonge Street, University Avenue, or Bloor Street
• type: the type of infrastructure
• segments: the number of segments
• len_km: the total length of the segments in km
• add_year: the year that the infrastructure was added
• add_type: the type of infrastructure added
• add_segments: the number of segments of the infrastructure added
• add_len_km: the length of the infrastructure added
• post_1st_ct: whether the year is on or after the first cycle track implementation
• post_1st_pl: whether the year is on or after the first painted or buffered lane implementation
• ksi: the total number of Killed or Seriously Injured (KSI) collisions
• non_ksi: the total number of non-KSI collisions
• <USER>_ksi: the number of KSI individuals for a road user group indicated by <USER>
• <USER>_non_ksi: the number of non-KSI individuals for a road user group indicated by <USER>
• <USER>_ksi_mean: the average number of KSI individuals for a road user group indicated by <USER> per segment
• <USER>_non_ksi_mean: the average number of non-KSI individuals for a road user group indicated by <USER> per segment

# Create output data
out <- colli_counts %>%
    mutate(
        group = glue("{user}_{ksi}")
    ) %>%
    pivot_wider(
        values_from = n,
        names_from = group
    ) %>%
    select(-user, -ksi) %>%
    group_by(year, quarter, street, type) %>%
    summarize(
        across(
            ends_with("_ksi"),
            ~ sum(., na.rm = T)
        ),
        across(
            c("add_year", "add_type"),
            ~ paste0(unique(.), collapse = ",")
        ),
        across(
            starts_with("post_"),
            ~ any(.)
        ),
        n_segments = sum(as.numeric(unique(n_segments)), na.rm = T),
        n_len_km = sum(as.numeric(unique(n_len_km)), na.rm = T),
        add_type = unique(add_type),
        add_segments = sum(as.numeric(unique(add_segments)), na.rm = T),
        add_len_km = sum(as.numeric(unique(add_len_km)), na.rm = T)
    ) %>%
    ungroup %>%
    mutate( # calc total ksi
        ksi = select(., !ends_with ("_non_ksi") & ends_with("_ksi")) %>%
            rowSums(na.rm = T),
        non_ksi = select(., ends_with("_non_ksi")) %>%
            rowSums(na.rm = T),
        across(starts_with("post_"), ~ if_else(is.na(.), F, .)),
        across(ends_with("_ksi"), ~ . / n_segments, .names = "{.col}_mean")
    ) %>%
    mutate(across( # set nan to na
        everything(),
        ~ ifelse(is.nan(.), NA, .)
    )) %>%
    select(order(colnames(.))) %>%
    select(
        year,
        quarter,
        street,
        type,
        segments = n_segments,
        len_km = n_len_km,
        add_year,
        add_type,
        add_segments,
        add_len_km,
        starts_with("post_"),
        ksi,
        non_ksi,
        everything()
    ) %>%
    arrange(street, year, quarter, type)

# Show data table
datatable(
    out,
    filename = glue("toronto-collisions-bloorunidanyonge-{today()}")
)

Rates

The rates data consists of quarterly rates by road user per year.

• year the year of the collisions
• street: the street, one of Yonge Street, University Avenue, or Bloor Street
• type: the type of infrastructure
• segments: the number of segments
• len_km: the total length of the segments in km
• add_year: the year that the infrastructure was added
• add_type: the type of infrastructure added
• add_segments: the number of segments of the infrastructure added
• add_len_km: the length of the infrastructure added
• post_1st_ct: whether the year is on or after the first cycle track implementation
• post_1st_pl: whether the year is on or after the first painted or buffered lane
• ksi: the total number of Killed or Seriously Injured (KSI) collisions
• non_ksi: the total number of non-KSI collisions
• <USER>_ksi: the number of KSI individuals for a road user group indicated by <USER>
• <USER>_non_ksi: the number of non-KSI individuals for a road user group indicated by <USER>
• <USER>_ksi_mean: the average number of KSI individuals for a road user group indicated by <USER> per segment
• <USER>_non_ksi_mean: the average number of non-KSI individuals for a road user group indicated by <USER> per segment
• <USER>_ksi_mean_quarter: the average number of KSI individuals for a road user group indicated by <USER> per quarter
• <USER>_non_ksi_mean_quarter: the average number of non-KSI collisions for a road user group indicated by <USER> per quarter

# Calc rates for output
out_rates <- out %>%
    group_by(street, year, type) %>%
    summarize(
        across( # means
            ends_with("ksi"),
            ~ sum(., na.rm = T) / sum(segments, na.rm = T),
            .names = "{.col}_mean"
        ),
        across( # quarterly means
            ends_with("ksi_mean"),
            ~ . / 4,
            .names = "{.col}_quarter"
        ),
        across( # sums
            ends_with("ksi"),
            ~ sum(., na.rm = T)
        ),
        across( # sum other vars
            c(segments, len_km),
            ~ sum(., na.rm = T)
        ),
        across( # unique other vars
            starts_with("add_") | starts_with("post_"),
            ~ paste0(unique(.), collapse = ",")
        )
    ) %>%
    mutate(across( # set nan to na
        everything(),
        ~ ifelse(is.nan(.), NA, .)
    )) %>%
    select(order(colnames(.))) %>%
    select(
        year,
        street,
        type,
        segments,
        len_km,
        add_year,
        add_type,
        add_segments,
        add_len_km,
        starts_with("post_"),
        ksi,
        non_ksi,
        ends_with("_ksi"),
        ksi_mean,
        non_ksi_mean,
        ends_with("_mean"),
        ksi_mean_quarter,
        non_ksi_mean_quarter,
        ends_with("_mean_quarter"),
        everything()
    ) %>%
    arrange(street, year, type)

# Show data table
datatable(
    out_rates,
    filename = glue("toronto-collisions-bloorunidanyonge-rates-{today()}")
)

Plots

These plots show the number of KSI collisions by road user for cycle tracks on Bloor Street, Danforth Street/Avenue, University Avenue, and Yonge Street. The dark gray dotted vertical lines show which year a cycle track is added to the street along with the amount of cycle track kilometers added.

# Prep plot data
plot_data <- colli_bike %>%
    as_tibble %>%
    select(-geometry) %>%
    mutate(
        year = year(colli_date),
        quarter = quarter(colli_date),
        user = str_to_title(user),
        ksi = if_else(ksi == "non_ksi", "Non-KSI", "KSI")
    ) %>%
    filter(user != "Other") %>%
    rename(
        street_orig = street,
        street = target_street
    ) %>%
    group_by(street, year, quarter, user, ksi) %>%
    count

# Add bike events to plot data
plot_data <- plot_data %>%
    left_join(
        bike_events_fill,
        by = c("street", "year")
    )

# Add cumulative sums for ct len
plot_data <- plot_data %>%
    group_by(street, user, ksi) %>%
    mutate(
        csum_km_ct = if_else(
            add_type == "cycle track" & year == add_year & quarter == 1,
            add_len_km,
            0
        ) %>% replace_na(0),
        csum_km_ct = cumsum(csum_km_ct)
    ) %>%
    arrange(street, year, quarter, user, ksi) %>%
    mutate(
        quarter_date = as_date(glue("{year}-0{quarter * 3}-01"))
    )

Non-KSI

# Generate plot for non ksi
ggplot(
    plot_data %>%
        filter(ksi == "Non-KSI" & !is.na(n)),
    aes(x = quarter_date, y = n)
) +
    geom_line(
        aes(color = csum_km_ct)
    ) +
    facet_grid(
        user ~ street,
        scales = "free",
        switch = "y"
    ) +
    geom_text(
        aes(label = n),
        size = 2.25,
        angle = 90,
        hjust = -2
    ) +
    scale_color_gradient(
        low = "lightgray",
        high = "black",
        name = "Cycle Track (km)",
        breaks = c(0, 2, 4, 6, 8, 10, 12, 15)
    ) +
    theme_minimal() +
    scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
    scale_y_continuous(expand = expansion(mult = c(0.1, 0.3))) +
    labs(
        x = "Year",
        y = "Non-KSI Individuals"
    ) +
    theme(
        axis.text.x = element_text(size = 8),
        legend.position = "top"
    )

KSI

# Generate plot for non ksi
ggplot(
    plot_data %>%
        filter(ksi == "KSI" & !is.na(n)),
    aes(x = quarter_date, y = n)
) +
    geom_line(
        aes(color = csum_km_ct)
    ) +
    facet_grid(
        user ~ street,
        scales = "free",
        switch = "y"
    ) +
    geom_text(
        aes(label = n),
        size = 2.25,
        angle = 90,
        hjust = -2
    ) +
    scale_color_gradient(
        low = "lightgray",
        high = "black",
        name = "Cycle Track (km)",
        breaks = c(0, 2, 4, 6, 8, 10, 12, 15)
    ) +
    theme_minimal() +
    scale_x_date(date_breaks = "1 year", date_labels = "%Y") +
    scale_y_continuous(expand = expansion(mult = c(0.1, 0.3))) +
    labs(
        x = "Year",
        y = "KSI Individuals"
    ) +
    theme(
        axis.text.x = element_text(size = 8),
        legend.position = "top"
    )

Maps

These map show the location of cycle tracks on Bloor Street, Danforth Street/Avenue, University Avenue, and Yonge Street, along with the collision density (determined by the number of individuals involved) within 25 meters of each cycle track.

Pre means before the noted year, and post means on or after the noted year (e.g. Pre-2022 is before 2022 and Post-2022 is on or after 2022).

# Function to produce a heatmap
plot_map <- function(
        user_type = NULL,
        ksi_type = NULL,
        pre = NULL,
        post = NULL,
        radius = 8,
        heatmap = T
    ) {
    
    # Filter colli data
    plot_colli <- colli_bike %>%
        mutate(
            year = year(colli_date)
        )
    if (!is.null(user_type)) {
        plot_colli <- plot_colli %>% filter(user %in% user_type)
    }
    if (!is.null(ksi_type)) {
        plot_colli <- plot_colli %>% filter(ksi %in% ksi_type)
    }
    if(!is.null(pre)) {
        plot_colli <- plot_colli %>% filter(year < pre)
    }
    if(!is.null(post)) {
        plot_colli <- plot_colli %>% filter(year >= post)
    }
    
    # Plot map
    tmap_mode("view")
    p <- tm_shape(bounds) +
        tm_polygons(alpha = 0, popup.vars = F, id = "") +
        tm_shape(streets) +
        tm_lines(col = "#1d1d1d", popup.vars = T) +
        tm_text("target_street", size = 1) +
        tm_shape(
            bike %>%
                select(-ends_with("_comment")) %>%
                filter(target_street != "Bloor & Danforth")
        ) +
        tm_lines(col = "red", lwd = 2, popup.vars = T)
    
    # If no heatmap, use points
    if (!heatmap) {
        p <- p +
            tm_shape(plot_colli) +
            tm_dots(clustering = T)
    }
    
    # Convert to leaflet
    p <- tmap_leaflet(p)
    
    # Add controls and legends
    p <- p %>%
        addFullscreenControl %>%
        addLegend(
            position = "topright",
            colors = c("red", "#1d1d1d"),
            labels = c("Cycle Track", "Street")
        ) %>%
        addLegend(
            position = "topright",
            colors = colorNumeric(
                c("blue", "green", "yellow", "orange"),
                domain = NULL
            )(seq(1, 100, length.out = 5)),
            values = c(1, 10),
            labels = c("Low", "", "", "", "High"),
            title = "Collision<br/>Density"
        )
    
    # Add heatmap
    if (heatmap) {
        p <- p %>% addHeatmap(
            data = plot_colli,
            lat = ~LATITUDE,
            lng = ~LONGITUDE,
            radius = radius
        )
    } else {
        p <- p %>%
            htmlwidgets::onRender("
                function(el, x) {
                    var css = '.marker-cluster span { color: black; font-size: 12px; }';
                    var style = document.createElement('style');
                    style.type = 'text/css';
                    if (style.styleSheet) {
                        style.styleSheet.cssText = css;
                    } else {
                        style.appendChild(document.createTextNode(css));
                    }
                    document.head.appendChild(style);
                }
            ")
    }
    return(p)
}

All Non-KSI

plot_map(ksi_type = "non_ksi")

All KSI

plot_map(ksi_type = "ksi", heatmap = F)

All Non-KSI (Pre-2022)

plot_map(ksi_type = "non_ksi", pre = 2022)

All KSI (Pre-2022)

plot_map(ksi_type = "ksi", pre = 2022, heatmap = F)

All Non-KSI (Post-2022)

plot_map(ksi_type = "non_ksi", post = 2022)

All KSI (Post-2022)

plot_map(ksi_type = "ksi", post = 2022, heatmap = F)

Cyclist Non-KSI

plot_map("cyclist", "non_ksi", radius = 12)

Cyclist KSI

plot_map("cyclist", "ksi", heatmap = F)

Cyclist Non-KSI (Pre-2022)

plot_map("cyclist", ksi_type = "non_ksi", pre = 2022)

Cyclist KSI (Pre-2022)

plot_map("cyclist", ksi_type = "ksi", pre = 2022, heatmap = F)

Cyclist Non-KSI (Post-2022)

plot_map("cyclist", ksi_type = "non_ksi", post = 2022, heatmap = F)

Cyclist KSI (Post-2022)

No Data.

Driver Non-KSI

plot_map("driver", "non_ksi")

Driver KSI

plot_map("driver", "ksi", heatmap = F)

Driver Non-KSI (Pre-2022)

plot_map("driver", ksi_type = "non_ksi", pre = 2022)

Driver KSI (Pre-2022)

plot_map("driver", ksi_type = "ksi", pre = 2022, heatmap = F)

Driver Non-KSI (Post-2022)

plot_map("driver", ksi_type = "non_ksi", radius = 12, post = 2022)

Driver KSI (Post-2022)

plot_map("driver", ksi_type = "ksi", post = 2022, heatmap = F)

Pedestrian Non-KSI

plot_map("pedestrian", "non_ksi", radius = 15)

Pedestrian KSI

plot_map("pedestrian", "ksi", heatmap = F)

Pedestrian Non-KSI (Pre-2022)

plot_map("pedestrian", ksi_type = "non_ksi", radius = 12, pre = 2022)

Pedestrian KSI (Pre-2022)

plot_map("pedestrian", ksi_type = "ksi", pre = 2022, heatmap = F)

Pedestrian Non-KSI (Post-2022)

plot_map("pedestrian", ksi_type = "non_ksi", heatmap = F, post = 2022)

Pedestrian KSI (Post-2022)

plot_map("pedestrian", ksi_type = "ksi", post = 2022, heatmap = F)